home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1992 June: ROMin Holiday / ADC Developer CD (1992-06) (''ROMin Holiday'')_iso / Developer Connection - 06-1992.iso / Tools & Apps / Devices & Hardware / Apple Desktop Bus / Lft⁄Rght Modifiersƒ / RightModsOn.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-09-14  |  4.5 KB  |  154 lines  |  [TEXT/TPAS]
  1. {[j=20-/40/80!,o=95,a-]}                    { PasMat formatting options }
  2.  
  3. {Cameron Birse, Macintosh Technical Support}
  4.  
  5. PROGRAM RightModsOn;
  6.  
  7. {$U MyStuff}
  8. USES
  9.     Memtypes,QuickDraw,OSIntf,ToolIntf,PackIntf,MacPrint,Script,mystuff;
  10. TYPE
  11.     fourBytes = packed array [0..3] of byte;
  12. VAR
  13.     myStr,ADBData : str255;
  14.     err,NumDevs,count            : Integer;
  15.           DevBlock    : ADBDataBlock;
  16.     TheWorld : SysEnvRec;
  17.     CompTrue,GotLEDs,gotADB : Boolean;
  18.     Addrs,KyBdAddrs,CmdNum : signedByte;
  19.     MyA5,R3Data : longint;
  20.     ParseData : fourBytes;
  21.  
  22.     {------------------------------------------------------------------------------------}
  23.  
  24. PROCEDURE ADBCompTalk;
  25.             
  26. BEGIN
  27.         
  28.     PushA5;
  29.     GetMyA5;
  30.              R3Data := GetADBData;
  31.              CompTrue := True;
  32.              PopA5;
  33.             
  34. END;
  35.  
  36.     {------------------------------------------------------------------------------------}
  37.     
  38. PROCEDURE ADBCompList;
  39.             
  40. BEGIN
  41.         
  42.     PushA5;
  43.     GetMyA5;
  44.              CompTrue := True;
  45.              PopA5;
  46.             
  47. END;
  48.  
  49.     {------------------------------------------------------------------------------------}
  50.  
  51. FUNCTION    CompCheck:integer;
  52.  
  53. begin
  54.     count := 0;
  55.     CompCheck := 0;                 {assume no error}
  56.     repeat
  57.         count := count + 1;         {timeout check}
  58.         if count = 10000 then
  59.         begin
  60.             CompCheck := count;       {My Timeout error code}
  61.             comptrue := true;
  62.         end
  63.     until comptrue;
  64. end;
  65.     {------------------------------------------------------------------------------------}
  66.  
  67. BEGIN                              {main PROGRAM}
  68.  
  69.     gotADB := false; {assume no ADB, and just exit if none}
  70.     err:= SysEnvirons (1,TheWorld);
  71.     if err = noerr then
  72.     begin
  73.         case theworld.machineType of
  74.          0,3,4 : gotADB := True;
  75.         end; {case}
  76.     end
  77.     else
  78.     begin
  79.         writeln ('SysEnvirons error = ',err);
  80.         writeln ('Please press the mouse button to exit');
  81.         repeat until button;
  82.     end;
  83.     If gotADB then
  84.     BEGIN
  85.         MyA5 := GetCurA5;
  86.               NumDevs := countADBs;
  87.         KyBdAddrs := 0;
  88.         GotLEDs := false;
  89.               repeat
  90.                      Addrs := GetIndADB (DevBlock, NumDevs);
  91.                      Case DevBlock.origADBAddr of
  92.                      2 : Begin
  93.                                       Case DevBlock.devType of 
  94.                                       1 : Begin
  95.                                                        GotLEDs := false;
  96.                                                 end;
  97.                                       2 : Begin
  98.                                                        GotLEDs := true;
  99.                             KyBdAddrs := Addrs;
  100.                                                 end;
  101.                                       end; {case}
  102.                                end;
  103.                      end; {case}
  104.             NumDevs := NumDevs - 1;
  105.         Until (NumDevs = -1) or GotLEDs;
  106.         if GotLeds then
  107.         begin
  108.                      Writeln ('Device = ',KyBdAddrs,' ; Device type = ',DevBlock.devType);
  109.                      Writeln ('ADB Address = ',KyBdAddrs,' ; Original Address = ',DevBlock.origADBAddr);
  110.             Writeln ('Routine Pointer = ',longint (DevBlock.dbServiceRtPtr),
  111.                     ' ;Data Area Address = ',longint (DevBlock.dbDataAreaAddr));
  112.                      writeln ('');
  113.             CompTrue := false;
  114.                            CmdNum := ((KyBdAddrs*16)+$0F);  {Device Address X, Talk command, Register 3}
  115.                               ADBData[0] := Char($00);
  116.                               ADBData[1] := Char($00);
  117.                               ADBData[2] := Char($00);
  118.                               err := ADBOp (@MyA5,@ADBCompTalk,@ADBData,CmdNum);
  119.             if err = noerr then
  120.             begin
  121.                 err := CompCheck;
  122.                 if err = noerr then
  123.                 begin
  124.                     ParseData := fourBytes(R3Data);
  125.                     writeln ('R3Data = ',ParseData[0],'-',ParseData[1],'-',ParseData[2]);
  126.                 end
  127.                 else Writeln ('Timeout error = ',err);
  128.             end
  129.             else Writeln ('ADBOp error = ',err);
  130.             if err = noerr then
  131.             begin
  132.                 CompTrue := false;
  133.                                CmdNum := ((KyBdAddrs*16)+$0B);  {Device Address X, Listen command, Register 3}
  134.                                   ADBData[0] := Char(ParseData[0]);
  135.                                   ADBData[1] := Char(ParseData[1]);
  136.                                   ADBData[2] := Char($03);
  137.                                   err := ADBOp (@MyA5,@ADBCompList,@ADBData,CmdNum);
  138.                 if err = noerr then
  139.                 begin
  140.                     err := CompCheck;
  141.                 end
  142.                 else Writeln ('ADBOp error = ',err);
  143.             end;
  144.             Writeln ('Press mouse to exit');
  145.             repeat until button;
  146.         end
  147.         else
  148.         begin
  149.             Writeln ('No Extended Keyboard');
  150.             Writeln ('Press mouse to exit');
  151.             repeat until button;
  152.         end;
  153.     end;
  154. End.